*PGID 0010
0090 !
0100 ! 100 - Initialization
0110 INIT:
0120 LET _SV_KR=PRM('KR'); SET_PARAM 'KR'=0 ! Ensure native handling of KEP()
0130 GOSUB SETUP_LIBRARY;IF %flmaint_msg$<>"" THEN MESSAGE_LIB %flmaint_msg$ 
0140 LET CHANGE_FLG=0,_ENABLE_FLG=0,_KCNT=1,_FIRST_KEY=0,_FIRST_FIELD=0
0150 GOSUB SETUP_KEYS
*FLNM 0160
*IF  LOCK_SEGMENT$="0"
T0170 LET _FIL_NO=HFN; OPEN (_FIL_NO,IOL=*,ERR=OPEN_ERR)_FILE_NAME$
F0170 LET _FIL_NO=HFN; OPEN (_FIL_NO,IOL=*,ERR=OPEN_ERR)_FILE_NAME$;READ (_FIL_NO,KEY=MIN_KEY$,DOM=*NEXT)
ENDIF
0190 RETURN 
0200 OPEN_ERR:MSGBOX _MSG_FILOPNERR1$+QUO+_FILE_NAME$+QUO+SEP+_MSG_DIRECTORY$+LWD+SEP+_MSG_PREFIX$+PFX,MSG(ERR),"!"
0210 LET CMD_STR$="END"
0220 RETURN 
0300 ! 300 - Set up the message library
0310 SETUP_LIBRARY:
0320 LET _SV_MSGLIB$=MSG(*)
*MLIB 0330
0360 SET_MSG: GOSUB SETUP_MESSAGES
0370 RETURN 
*DEL 0400-0490
0400 ! 400 - Set up key information
0410 SETUP_KEYS:
*NKEY 0420
0490 RETURN
0500 ! 500 - Main panel post_display logic
0510 MAIN_POST_DISPLAY:
0520 MESSAGE_LIB _SV_MSGLIB$
0530 GOSUB CLEAR_REC
0540 IF ARG_1$="" THEN LET _ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS; GOTO *RETURN
0550 LET _KEY$=ARG_1$; READ (_FIL_NO,KEY=_KEY$,ERR=NEXT_REC)
0560 LET _ENABLE_FLG=-1; GOSUB PROCESS_READ; GOSUB DISP_REC
0570 RETURN 
*DEL  0700-0790
*SKIP 0740 IF FLDR=0
0700 ! 700 - Set up tabbing between folders
0710 INIT_FOLDER:
0720 GOSUB ENABLE_GROUPS
0730 IF _ENABLE_FLG<>_KEY1 THEN IF TAB_FLG$="<" THEN NEXT_ID=_LAST_TAB ELSE NEXT_ID=_FIRST_TAB
0740 EXIT 
0900 ! 900 - Wrapup
0910 WRAPUP:
0920 LET ARG_1$=KEC(_FIL_NO,ERR=*NEXT)
0930 IF _FIL_NO<>0 THEN CLOSE (_FIL_NO); LET _FIL_NO=0
0950 MESSAGE_LIB _SV_MSGLIB$ 
0960 SET_PARAM 'KR'=_SV_KR
0970 RETURN 
1000 ! 1000 - Start of maintenance only code - Find/Add/Delete/Clear record
1010 FIND_REC:
1020 CHANGE_FLG=0;IF POS(_EOM$=$000102090d$)=0 THEN RETURN ELSE GOSUB GET_CURKEY;IF _EOM$=$00$ THEN IF QRY_VAL$<>"" AND QRY_VAL$=EVS(_KEYS$[_CURKEY]) THEN QRY_VAL$="" ELSE RETURN
1030 IF _ENABLE_FLG<0 THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1
1040 IF _ENABLE_FLG THEN IF _KCNT<_NUMKEYS THEN LET _KCNT=_CURKEY+1,_ENABLE_FLG=_KCNT; GOSUB ENABLE_GROUPS; RETURN ! If multiple key segments, enable the _KCNT segment
*KEYS 1050
1060 IF NUL(STP(_KEY$,1,$00$)) THEN NEXT_ID=_first_key;RETURN 
1070 READ (_FIL_NO,KEY=_KEY$,DOM=NEW_RECORD,ERR=CHK_ERR_NXT)
1080 GOSUB PROCESS_READ
1090 GOSUB NUM_TO_STR
1100 LET CHANGE_FLG=0,REFRESH_FLG=1,NEXT_ID=_first_field
1110 EXIT 
1200 ! 1200 - New RECORD check
1210 NEW_RECORD:
*IF  GEN_CNF_NEW$="1"
T1220 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$
T1230 MSGBOX _MSG_REC_MISS1$+_R_KEY$+_MSG_REC_MISS2$+SEP+_MSG_REC_CR_NEW$,_MSG_NOT_FOUND$,"?,YESNO",_YESNO$
T1240 IF _YESNO$="NO" THEN LET NEXT_ID=_first_key,CHANGE_FLG=0;EXIT 
F1220
F1230
F1240
ENDIF
*IF  CLEAR_OPT$="2" 
T1250 _CLR_FLG$="F";GOSUB CLEAR_FIELDS
F1250
ENDIF
1260 IF _ENABLE_FLG THEN LET _KCNT=0,_ENABLE_FLG=-1; GOSUB ENABLE_GROUPS
1270 LET CHANGE_FLG=0,REFRESH_FLG=1,NEXT_ID=_first_field
*IF  FIRST_FOLDER$<>""
T1280 NEXT_FOLDER=_first_folder
F1280
ENDIF
1290 RETURN 
1400 ! 1400 - Add RECORD
1410 WRITE_REC:
1420 GOSUB STR_TO_NUM
1430 GOSUB CHECK_REQD_FLDS; IF _W_FLG=0 THEN IGNORE_EXIT=1;EXIT
*IF  UPD_OPT$="1" 
T1440 GOSUB REVIEW_WRITE; IF _ABORT_WRITE THEN _ABORT_WRITE=0; RETURN
ENDIF
*IF  UPD_OPT$<>"1" AND _EXKEY=0
T1440 WRITE (_FIL_NO,ERR=WRITE_ERROR)
ENDIF
*IF  UPD_OPT$<>"1" AND _EXKEY<>0
T1440 WRITE (_FIL_NO,KEY=_KEY$,ERR=WRITE_ERROR) 
ENDIF
*IF  UPD_OPT$<>"1" AND GEN_ACK_WRT$="1"
T1450 LET _R_KEY$=KEC(_FIL_NO); TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_UPDADD$+_R_KEY$,_FYI$,"INFO"
ENDIF
1460 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
1470 LET CHANGE_FLG=0
1480 NEXT_ID=_first_key
1490 EXIT 
1600 ! 1600 - Delete
1610 DELETE_REC:
*KEYS 1620
*IF  GEN_CNF_DEL$="1"
T1630 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$
T1640 MSGBOX _MSG_REC_VFYDEL1$+_R_KEY$+_MSG_REC_VFYDEL2$,_MSG_JUST_CHECK$,"?,YESNO",_X$
T1650 IF _X$<>"YES" THEN RETURN
F1630
F1640
F1650
ENDIF
1660 REMOVE (_FIL_NO,KEY=_KEY$,ERR=NO_SUCH)
*IF  GEN_ACK_DEL$="1"
T1670 LET _R_KEY$=_KEY$; TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_REMOVE$+_R_KEY$,_FYI$,"INFO"
F1670
ENDIF
1680 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
1690 LET CHANGE_FLG=0
1700 NEXT_ID=_first_key
1710 EXIT
1720 NO_SUCH: MSGBOX _MSG_REC_NOTFND$,_FYI$,"!"; EXIT 
1800 ! 1800 - Clear record
1810 CLEAR_REC:
1820 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
1830 _CLR_FLG$="R";GOSUB CLEAR_FIELDS
1840 IF _ENABLE_FLG THEN LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
1850 LET CHANGE_FLG=0
1860 RETURN
2000 ! 2000 - Browsing mode
2010 ! - Next
2020 NEXT_REC:
2030 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  UPD_OPT$="2"
T2040 LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE);IF _KEY$=_CUR_KEY$ THEN LET _KEY$=KEN(_FIL_NO,END=END_OF_FILE) ! Get past extracted record
F2040 LET _KEY$=KEY(_FIL_NO,END=END_OF_FILE)
ENDIF
*IF  LOCK_SEGMENT$="0"
T2050
F2050 IF _KEY$>MAX_KEY$+$FF$ THEN GOTO END_OF_FILE
ENDIF
2060 READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT); GOSUB PROCESS_READ; GOTO DISP_REC
2070 CHK_ERR_NXT: IF ERR<>0 THEN EXIT ERR
2080 LET _D$=_MSG_NEXT$; GOSUB BUSY_CHK
2090 LET _KEY$=KEN(_FIL_NO,KEY=_KEY$,END=END_OF_FILE); READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT); GOSUB PROCESS_READ; GOTO DISP_REC
2100 END_OF_FILE: MSGBOX _MSG_END_OF_FIL$,_FYI$,"!"; EXIT 
2200 ! 2200 - Prior record
2210 PRIOR_REC:
2220 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0"
T2230 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT); GOSUB PROCESS_READ; GOTO DISP_REC
F2230 LET _KEY$=KEP(_FIL_NO,END=START_OF_FILE); IF _KEY$<MIN_KEY$ THEN GOTO START_OF_FILE ELSE READ (_FIL_NO,KEY=_KEY$,ERR=*NEXT); GOSUB PROCESS_READ; GOTO DISP_REC
ENDIF
2240 CHK_ERR_PRE: IF ERR<>0 THEN EXIT ERR
2250 LET _D$=_MSG_PRECEDING$; GOSUB BUSY_CHK
2260 LET _KEY$=KEP(_FIL_NO,KEY=_KEY$,END=START_OF_FILE); READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); GOSUB PROCESS_READ; GOTO DISP_REC
2270 START_OF_FILE: MSGBOX _MSG_START_FILE$,_FYI$,"!"; EXIT 
2400 ! 2400 - First record
2410 FIRST_REC:
2420 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0"
T2430 LET _KEY$=KEF(_FIL_NO,ERR=NO_FIRST)
T2440
F2430 LET _KEY$=MIN_KEY$;READ (_FIL_NO,KEY=_KEY$,DOM=*NEXT,ERR=CHK_ERR_NXT);GOTO 2450
F2440 LET _KEY$=KEY (_FIL_NO,ERR=NO_FIRST);IF _KEY$>MAX_KEY$+$FF$ THEN GOTO NO_FIRST
ENDIF
2450 READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_NXT); GOSUB PROCESS_READ; GOTO DISP_REC 
2460 NO_FIRST:MSGBOX _MSG_REC_NO_1ST$,_FYI$,"!"; EXIT 
2600 ! 2600 - Last record
2610 LAST_REC:
2620 IF CHANGE_FLG<>0 THEN GOSUB CHECK_CHANGES
*IF  LOCK_SEGMENT$="0"
T2630 LET _KEY$=KEL(_FIL_NO,ERR=NO_LAST)
T2640
F2630 LET _KEY$=MAX_KEY$+$FF$;READ (_FIL_NO,KEY=_KEY$,DOM=*NEXT,ERR=CHK_ERR_PRE);GOTO 2650
F2640 LET _KEY$=KEP (_FIL_NO,ERR=NO_LAST);IF _KEY$<MIN_KEY$ THEN GOTO NO_LAST
ENDIF
2650 READ (_FIL_NO,KEY=_KEY$,ERR=CHK_ERR_PRE); GOSUB PROCESS_READ; GOTO DISP_REC
2660 NO_LAST:MSGBOX _MSG_REC_NO_LST$,_FYI$,"!"; EXIT 
3000 ! 3000 - Subroutines
3010 ! Processing required by READ
3020 PROCESS_READ:
*IF  _EXKEY
T3030 READ DATA FROM _KEY$ TO IOL=IOL(_FIL_NO:KEY,ERR=*NEXT) ! load fields from external key
F3030
ENDIF
3040 IF _ENABLE_FLG THEN LET _KCNT=_KEY1-1,_ENABLE_FLG=-1; GOSUB ENABLE_GROUPS
*IF  UPD_OPT$="1"
T3050 READ DATA FROM REC(IOL(_FIL_NO,ERR=*NEXT)),REC=_ORIG$ TO IOL=IOL(_FIL_NO) ! Save record for review
T3060 LET CHANGE_FLG=0
ENDIF
*IF  UPD_OPT$="2"
T3050 EXTRACT (_FIL_NO,KEY=_KEY$)
T3060 LET _CUR_KEY$=_KEY$
ENDIF
*IF  UPD_OPT$="3"
T3050
T3060
ENDIF
3070 RETURN
*DEL  3200-3440
*SKIP 3370 IF UPD_OPT$<>"1"
3200 ! 3200 - Review record for changes before WRITE 
3210 REVIEW_WRITE:
3220 LET _CHG1$="",_CHG2$="",_ABORT_WRITE=0
3230 EXTRACT (_FIL_NO,KEY=KEC(_FIL_NO),REC=_CUR$,DOM=WRT,ERR=REC_BUSY)
3240 GOSUB DETERMINE_CHGS
3250 IF _CHG1$="" AND _CHG2$="" THEN GOTO WRT
3260 IF _CHG1$="" THEN GOTO CHK2
3270 MSGBOX _MSG_UPD_SAME$+SEP+_CHG1$+SEP+SEP+_MSG_OVRWRT_CHG$,_MSG_WARNING$,"Yesno,1,!",_YESNO$
3280 IF _YESNO$="NO" THEN GOTO *RETURN
3290 IF _CHG2$="" THEN GOTO WRT
3300 CHK2:IF _CHG2$<>"" THEN MSGBOX _MSG_UPD_OTHER1$+SEP+_CHG2$+SEP+SEP+_MSG_UPD_OTHER2$,_FYI$,"!"
3310 GOSUB INCORPORATE_CHGS
*IF  _EXKEY=0
T3320 WRT:WRITE (_FIL_NO,ERR=WRITE_ERROR)
F3320 WRT:WRITE (_FIL_NO,KEY=_KEY$,ERR=WRITE_ERROR)
ENDIF
*IF  GEN_ACK_WRT$="1"
T3330  LET _R_KEY$=KEC(_FIL_NO); TRANSLATE _R_KEY$," ",$00$; MSGBOX _MSG_REC_UPDADD$+_R_KEY$,_FYI$,"INFO"
F3330
ENDIF
3340 READ DATA FROM REC(IOL(_FIL_NO,ERR=*NEXT)),REC=_ORIG$ TO IOL=IOL(_FIL_NO) ! Save record for review
3350 GOSUB NUM_TO_STR
3360 LET REFRESH_FLG=1
3370 RETURN 
3380 WRITE_ERROR:
3390 IF ERR=11 THEN MSGBOX _MSG_DUP_UNIQUE$,_MSG_CANNOT_WRITE$ ELSE MSGBOX MSG(ERR),_MSG_CANNOT_WRITE$
3400 RETURN
*IF  UPD_OPT$="1"
T3410 REC_BUSY:
T3420 IF ERR=0 THEN MSGBOX _MSG_REC_LOCKED$,_MSG_CANNOT_WRITE$ ELSE MSGBOX MSG_CANNOT_WRITE$+SEP+MSG(ERR),_ERROR$
T3430 _ABORT_WRITE=1
T3440 RETURN
F3410
F3420
F3430
F3440
ENDIF
3500 ! 3500 - Display a record
3510 DISP_REC:
3520 GOSUB NUM_TO_STR
3530 LET REFRESH_FLG=1
3540 RETURN 
3600 ! 3600 - Busy Record display
3610 BUSY_CHK:
3620 MSGBOX _MSG_REC_LOCKED$+SEP+SEP+_MSG_REC_VIEW1$+_D$+_MSG_REC_VIEW2$,_MSG_REC_ACCESS$,"YESNO,!",_D$
3630 IF _D$="NO" THEN EXIT 
3640 RETURN
3790 !3790 - See if changes are to be written
3800 CHECK_CHANGES:
*INCT 3810
3820 IF CHANGE_FLG=0 THEN IF _ENABLE_FLG THEN GOTO CC ELSE GOTO *RETURN
3830 MSGBOX _MSG_REC_ALTERD$,_MSG_UPDATE$,"?,Yesno",_YESNO$
3840 IF _YESNO$="YES" THEN GOTO WRITE_REC
3850 LET CHANGE_FLG=0
3860 CC:LET _KCNT=_KEY1,_ENABLE_FLG=_KEY1; GOSUB ENABLE_GROUPS
3870 RETURN
4000 ! 4000 - Get the current key segment number
4010 GET_CURKEY:
4020 FOR _CURKEY=1 TO _NUMKEYS
4030 IF UCS(_KEYS$[_CURKEY])=ucs(ID$)+"$" OR ucs(_KEYS$[_CURKEY])=ucs(ID$) THEN EXITTO *RETURN
4040 NEXT _CURKEY
4050 RETURN
09000 ! 9000 - Retrieve messages from the *msglib.xxx library
09010 SETUP_MESSAGES:
09020 LET _FYI$=MSG("FYI"),_ERROR$=MSG("ERROR")
09030 LET _MSG_DIRECTORY$=MSG("DIRECTORY")
09040 LET _MSG_END_OF_FIL$=MSG("END_OF_FIL")
09050 LET _MSG_FILOPNERR1$=MSG("FILOPNERR1")
09060 LET _MSG_JUST_CHECK$=MSG("JUST_CHECK")
09070 LET _MSG_MANDATORY$=MSG("MANDATORY")
09080 LET _MSG_NEXT$=MSG("NEXT")
09090 LET _MSG_NON_NUMER$=MSG("NON_NUMER")
09100 LET _MSG_NOT_FOUND$=MSG("NOT_FOUND")
09110 LET _MSG_OVRWRT_CHG$=MSG("OVRWRT_CHG")
09120 LET _MSG_PRECEDING$=MSG("PRECEDING")
09130 LET _MSG_PREFIX$=MSG("PREFIX")
09140 LET _MSG_REC_ACCESS$=MSG("REC_ACCESS")
09150 LET _MSG_REC_ALTERD$=MSG("REC_ALTERD")
09160 LET _MSG_REC_CR_NEW$=MSG("REC_CR_NEW")
09170 LET _MSG_REC_LOCKED$=MSG("REC_LOCKED")
09180 LET _MSG_X$=MSG("REC_MISS","^"),P=POS("^"=_MSG_X$),_MSG_REC_MISS1$=_MSG_X$(1,P-1),_MSG_REC_MISS2$=_MSG_X$(P+1)
09190 LET _MSG_REC_NOTFND$=MSG("REC_NOTFND")
09200 LET _MSG_REC_NO_1ST$=MSG("REC_NO_1ST")
09210 LET _MSG_REC_NO_LST$=MSG("REC_NO_LST")
09220 LET _MSG_REC_REMOVE$=MSG("REC_REMOVE")
09230 LET _MSG_REC_UPDADD$=MSG("REC_UPDADD")
09240 LET _MSG_X$=MSG("REC_VFYDEL","^"),P=POS("^"=_MSG_X$),_MSG_REC_VFYDEL1$=_MSG_X$(1,P-1),_MSG_REC_VFYDEL2$=_MSG_X$(P+1)
09250 LET _MSG_X$=MSG("REC_VIEW","^"),P=POS("^"=_MSG_X$),_MSG_REC_VIEW1$=_MSG_X$(1,P-1),_MSG_REC_VIEW2$=_MSG_X$(P+1)
09260 LET _MSG_REQ_FIELDS$=MSG("REQ_FIELDS")
09270 LET _MSG_START_FILE$=MSG("START_FILE")
09280 LET _MSG_UPDATE$=MSG("UPDATE")
09290 LET _MSG_UPD_OTHER1$=MSG("UPD_OTHER1")
09300 LET _MSG_UPD_OTHER2$=MSG("UPD_OTHER2")
09310 LET _MSG_UPD_SAME$=MSG("UPD_SAME")
09320 LET _MSG_WARNING$=MSG("WARNING")
09330 LET _MSG_CANNOT_WRITE$=MSG("CANT_WRITE")
09340 LET _MSG_DUP_UNIQUE$=MSG("DUP_UNIQUE")
09350 RETURN
10000 ! 10000 - Convert numeric values to string
10010 NUM_TO_STR:
*DEL  10020-10990
*CVTN 10020
10999 RETURN
11000 ! 11000 - Convert numeric strings to number
11010 STR_TO_NUM:
*DEL  11020-11960
*CVTS 11020
11970 RETURN
11980 NON_NUMERIC:MSGBOX _MSG_NON_NUMER$+_X$,_ERROR$,"!"
11990 LET NEXT_ID=_X
11999 EXIT
12000 ! 12000 - Check if the required fields have data
12010 CHECK_REQD_FLDS:
*IF  RCNT>0
T12020 LET _W_FLG=1,_REQ_LST$="",_REQ_CTL=0,_nf=0
F12020 LET _W_FLG=1
ENDIF
*REQD 12030
*IF  RCNT>0
T12990 IF _REQ_LST$<>"" THEN LET _W_FLG=0; MSGBOX _MSG_REQ_FIELDS$+SEP+_REQ_LST$,_MSG_MANDATORY$;NEXT_ID=_REQ_CTL;IF _NF>0 THEN NEXT_FOLDER=_NF,NEXT_ID$=_NI$
F12990
ENDIF
12999 RETURN 
13000 ! 13000 - Clear the record fields
13010 CLEAR_FIELDS:
*DEL  13020-13970
*CLR  13020
13980 GOSUB NUM_TO_STR
13990 LET REFRESH_FLG=1
13999 RETURN 
14000 ! 14000 - Enable/Disable groups - _ENABLE_FLG: 0=don't!, >1=corresponding key segment on, others off, -1=buttons and non-key fields on
14010 ENABLE_GROUPS:
14020 IF _ENABLE_FLG=0 THEN GOTO *RETURN
*DEL  14030-14960
*ENAB 14030
14970 IF _ENABLE_FLG>0 THEN CALL "*wingrp;Disable",FIELDS.GRP$; CALL "*wingrp;Disable",BUTTONS.GRP$
14980 IF _ENABLE_FLG<0 THEN CALL "*wingrp;Enable",FIELDS.GRP$; CALL "*wingrp;Enable",BUTTONS.GRP$
14990 RETURN 
*DEL  15000-16990
*SKIP 16990 IF UPD_OPT$<>"1"
15000 ! 15000 - Determine the changes that have been made before writing
15010 DETERMINE_CHGS:
*DCHG 15020
15990 RETURN
16000 ! 16000 - Incorporate changes made by another user into the record
16010 INCORPORATE_CHGS:
*ICHG 16020
16990 RETURN

